Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue56/System/RASConnection.pas

Pascal/Delphi Source File | 2000-03-04 | 6.2 KB | 183 lines

unit RASConnection;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, RASBase;

type
    TRASConnectionManager = class (TRASBaseComponent)
    private
        { Private declarations }
        fTimer: Integer;
        fConnectionNames, fDummy1: TStrings;
        fOnStatusChange: TNotifyEvent;
        function GetStatus (Index: Integer): String;
        function StatusChanged (NewStatus: TStringList): Boolean;
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create (AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Refresh;
        property Status [Index: Integer]: String read GetStatus;
    published
        { Published declarations }
        property ConnectionNames: TStrings read fConnectionNames write fDummy1 stored False;
        property OnStatusChange: TNotifyEvent read fOnStatusChange write fOnStatusChange;
    end;

procedure Register;

implementation

var
    InstanceHack: TRASConnectionManager;

procedure TimerTickProc (Wnd: hWnd; Msg, Event, Time: Integer); stdcall;
begin
    InstanceHack.Refresh;
end;

function ConStateToString (State: Integer): String;
begin
    case State of
    $0000:      Result := 'Com Port Opening';
    $0001:      Result := 'Com Port Opened';
    $0002:      Result := 'Connecting Device';
    $0003:      Result := 'Device Connected';
    $0004:      Result := 'All Connected';
    $0005:      Result := 'Starting Authenticate';
    $0006:      Result := 'Authentication Event';
    $0007:      Result := 'Retrying Authentication';
    $0008:      Result := 'Callback number requested';
    $0009:      Result := 'Password change request';
    $000A:      Result := 'Projection Starting';
    $000B:      Result := 'Calculating Link Speed';
    $000C:      Result := 'Acknowledging Authentication Request';
    $000D:      Result := 'Starting Reauthentication';
    $000E:      Result := 'Successfully Authenticated';
    $000F:      Result := 'Disconnecting for callback';
    $0010:      Result := 'Resetting modem for callback';
    $0011:      Result := 'Waiting for callback';
    $0012:      Result := 'Projection complete';
    $0013:      Result := 'Authenticating user';
    $0014:      Result := 'Callback complete';
    $0015:      Result := 'Logging onto network';
    $0016:      Result := 'Subentry connected';
    $0017:      Result := 'Subentry disconnected';
    $1000:      Result := 'Terminal State';
    $1001:      Result := 'Retrying Authentication';
    $1002:      Result := 'Callback set by user';
    $1003:      Result := 'Password has expired';
    $1004:      Result := 'Paused for EAPUI';
    $2000:      Result := 'Successful connection';
    $2001:      Result := 'Failed connection';
    else        Result := 'Unknown';
    end;
end;

constructor TRASConnectionManager.Create (AOwner: TComponent);
begin
    // Yes, it's dirty, but it's also quick. ;-)
    if InstanceHack <> Nil then Exception.Create ('Only one TRASConnectionManager allowed');
    Inherited Create (AOwner);
    InstanceHack := Self;
    fConnectionNames := TStringList.Create;
    Refresh;
    fTimer := SetTimer (0, 999, 1000, @TimerTickProc);
end;

destructor TRASConnectionManager.Destroy;
begin
    if fTimer <> 0 then KillTimer (0, fTimer);
    fConnectionNames.Free;
    Inherited;
    InstanceHack := Nil;
end;

function TRASConnectionManager.StatusChanged (NewStatus: TStringList): Boolean;
var
    Idx: Integer;
begin
    Result := fConnectionNames.Count <> NewStatus.Count;
    if not Result then begin
        Result := True;
        for Idx := 0 to fConnectionNames.Count - 1 do begin
            if fConnectionNames [Idx] <> NewStatus [Idx] then Exit;
            if fConnectionNames.Objects [Idx] <> NewStatus.Objects [Idx] then Exit;
        end;

        Result := False;
    end;
end;

procedure TRASConnectionManager.Refresh;
type
    TRasConn = record
        dwSize: DWord;
        hConn: THandle;
        EntryName: array [0..20] of Char;
    end;

    TRasConStatus = record
        dwSize: DWord;
        ConState: Integer;
        Error: Integer;
        DeviceType: array [0..16] of Char;
        DeviceName: array [0..32] of Char;
    end;

var
    CurCon: ^TRasConn;
    NewStatus: TStringList;
    Status: TRasConStatus;
    Buffer: array [0..10000] of Char;
    Idx, BufSize, NumConnections: Integer;
    RasEnumConnections: function (Buffer: PChar; var BufSize, NumConnections: Integer): Integer; stdcall;
    RasGetConnectStatus: function (hConn: THandle; var Status: TRasConStatus): Integer; stdcall;
begin
    if Available then begin
        RasEnumConnections := GetProc ('RasEnumConnectionsA');
        RasGetConnectStatus := GetProc ('RasGetConnectStatusA');
        if Assigned (RasEnumConnections) and Assigned (RasGetConnectStatus) then begin
            NewStatus := TStringList.Create;
            try
                CurCon := @Buffer;
                CurCon^.dwSize := sizeof (TRasConn);
                BufSize := sizeof (Buffer);
                if CallProc (RasEnumConnections (Buffer, BufSize, NumConnections)) then
                    for Idx := 0 to NumConnections - 1 do begin
                        Status.dwSize := sizeof (Status);
                        if CallProc (RasGetConnectStatus (CurCon^.hConn, Status)) then
                            NewStatus.AddObject (CurCon^.EntryName, TObject (Status.ConState));
                        Inc (CurCon);
                    end;

                // Now see if anything has changed
                if StatusChanged (NewStatus) then begin
                    fConnectionNames.Assign (NewStatus);
                    if Assigned (OnStatusChange) then OnStatusChange (Self);
                end;
            finally
                NewStatus.Free;
            end;
        end;
    end;
end;

function TRASConnectionManager.GetStatus (Index: Integer): String;
begin
    Result := '';
    if Index < fConnectionNames.Count then
        Result := ConStateToString (Integer (fConnectionNames.Objects [Index]));
end;

procedure Register;
begin
    RegisterComponents ('DelphiMag', [TRASConnectionManager]);
end;

end.